home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 1 / Meeting Pearls Vol 1 (1994).iso / installed_progs / comm / ums / developer.lha / Developer / demo / WriteMessage.mod < prev    next >
Encoding:
Text File  |  1993-09-23  |  4.4 KB  |  150 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       WriteMessage
  3.   :Contents.      writes a new message to UMS' messagebase
  4.   :Author.        Kai Bolay [kai]
  5.   :Address.       Snail Mail:              EMail:
  6.   :Address.       Hoffmannstraße 168       UUCP: kai@amokle.stgt.sub.org
  7.   :Address.       D-71229                  Leonberg  FIDO: 2:2407/106.3
  8.   :History.       v1.0 [kai] 25-Mar-93 (added Martin's suggestion)
  9.   :History.       v1.1 [kai] 31-Mar-93 (added new tags, toAddr only if private)
  10.   :History.       v1.2 [kai] 15-Apr-93 (added SERVER keyword, better Login() failure)
  11.   :History.       v1.3 [kai] 22-Sep-93 (updated for V40 Intefaces)
  12.   :Copyright.     Public Domain
  13.   :Language.      Oberon
  14.   :Translator.    AMIGA OBERON v3.01d
  15.   :Imports.       ums
  16.   :Bugs.          Does not create links (crosspostings, carbon copies)
  17. ------------------------------------------------------------------------ *)
  18. MODULE WriteMessage;
  19.  
  20. IMPORT
  21.   ums,
  22.   I: Intuition, d: Dos, e: Exec, u: Utility,
  23.   NoGuru, Break,
  24.   y: SYSTEM;
  25. CONST
  26.   Template = "USER/A,PASSWORD/A,SERVER/K\o$VER: WriteMessage 1.3 (22.9.93)\n\r";
  27.   Msg = "This is an automatically created message because I'm too lazy to write\n"
  28.         "a complete newsreader.\n"
  29.         "\n"
  30.         "If you improve this program in order to enable the user to write real\n"
  31.         "messages please let me know.\n"
  32.         "\n"
  33.         "  Bye, Kai\n"
  34.         "\n"
  35.         "-- \n"
  36.         "This is no signature :-)\n";
  37. VAR
  38.   RD: d.RDArgsPtr;
  39.   Args: STRUCT (dummy: d.ArgsStruct)
  40.     name: e.STRPTR;
  41.     password: e.STRPTR;
  42.     server: e.STRPTR;
  43.   END;
  44.   acc: LONGINT;
  45.   Fields: ums.MsgTextFields;
  46.   i: INTEGER;
  47.   num: LONGINT;
  48.  
  49. (* $Debug- *)
  50. PROCEDURE CheckErr;
  51. VAR
  52.   err: INTEGER;
  53.   txt: ums.STRPTR;
  54. BEGIN
  55.   err := ums.ErrNum (acc);
  56.   IF err # ums.ok THEN
  57.     txt := ums.ErrTxt (acc);
  58.     d.PrintF ("UMS-error: %ld, \"%s\"\n", err, txt);
  59.     HALT (20);
  60.   END;
  61. END CheckErr;
  62. (* $Debug= *)
  63.  
  64. PROCEDURE GetString (Prompt:  ARRAY OF CHAR): ums.STRPTR;
  65. CONST
  66.   MaxChars = 256;
  67. VAR
  68.   buffer: ums.STRPTR;
  69.   i: INTEGER;
  70. BEGIN
  71.   IF d.FPuts (d.Output(), Prompt) AND d.Flush (d.Output()) THEN END;
  72.   buffer := e.AllocVec (MaxChars, LONGSET {e.memClear});
  73.   IF buffer # NIL THEN
  74.     IF d.FGets (d.Input(), buffer^, MaxChars-1) = NIL THEN END;
  75.     i := 0;
  76.     REPEAT
  77.       IF buffer[i] = '\n' THEN buffer[i] := 0X END;
  78.       INC (i);
  79.     UNTIL buffer[i] = 0X;
  80.     IF buffer[0] = 0X THEN
  81.       e.FreeVec (buffer); buffer := NIL;
  82.     END;
  83.   END;
  84.   RETURN buffer;
  85. END GetString;
  86.  
  87. BEGIN
  88.   i := 0;
  89.   REPEAT
  90.     Fields[i] := NIL;
  91.     INC (i);
  92.   UNTIL i = ums.NumFields;
  93.  
  94.   RD := d.ReadArgs (Template, Args, NIL);
  95.   IF RD = NIL THEN
  96.     d.PrintF ("Usage: %s\n", y.ADR (Template));
  97.     HALT (20);
  98.   END;
  99.  
  100.   (* $OddChk- $NilChk- *)
  101.   acc := ums.UMSRLogin (Args.server^, Args.name^, Args.password^);
  102.   (* $OddChk= $NilChk= *)
  103.   IF acc <= 0 THEN
  104.     d.PrintF ("Unable to login\n");
  105.     HALT (20);
  106.   END;
  107.  
  108.   Fields[ums.group]        := GetString ("Group (<RETURN> for private mail): ");
  109.   IF Fields[ums.group] # NIL THEN
  110.     Fields[ums.replyGroup] := GetString ("Reply Group: ");
  111.   END;
  112.   Fields[ums.replyName]    := GetString ("Reply Name: ");
  113.   IF Fields[ums.replyName] # NIL THEN
  114.     Fields[ums.replyAddr]    := GetString ("Reply Addr: ");
  115.   END;
  116.   Fields[ums.toName]       := GetString ("To Name: ");
  117.   IF Fields[ums.group] = NIL THEN
  118.     Fields[ums.toAddr]     := GetString ("To Addr: ");
  119.   END;
  120.   Fields[ums.refID]        := GetString ("Refer-ID: ");
  121.   Fields[ums.subject]      := GetString ("Subject: ");
  122.   Fields[ums.attributes]   := GetString ("Attributes: ");
  123.   Fields[ums.organization] := GetString ("Organization: ");
  124.   Fields[ums.distribution] := GetString ("Distribution: ");
  125.   Fields[ums.newsreader]   := y.ADR ("WriteMessage 1.2");
  126.   Fields[ums.msgText]      := y.ADR (Msg);
  127.  
  128.   (* write the message *)
  129.   num := ums.WriteUMSMsgTags (acc, ums.tagTextFields, y.ADR (Fields),
  130.                                    u.done);
  131.   CheckErr;
  132.   d.PrintF ("Your message got number %ld.\n", num);
  133. CLOSE
  134.   IF acc # NIL THEN
  135.     ums.Logout (acc); acc := 0;
  136.   END;
  137.   IF RD # NIL THEN
  138.     d.FreeArgs (RD); RD := NIL;
  139.   END;
  140.   Fields[ums.newsreader] := NIL; (* not allocated by AllocVec() !! *)
  141.   Fields[ums.msgText]    := NIL; (* not allocated by AllocVec() !! *)
  142.   i := 0;
  143.   REPEAT
  144.     IF Fields[i] # NIL THEN
  145.       e.FreeVec (Fields[i]); Fields[i] := NIL;
  146.     END;
  147.     INC (i);
  148.   UNTIL i = ums.NumFields;
  149. END WriteMessage.
  150.